00100	C THIS AIDS IN EXTRACTING PARTS FROM SCORES - OR PACKING OF .DAT
00200	C   FILES FOR EASIER STORAGE.   
00300	      DIMENSION XN(2000),RSTFAC(8),IV(78),LIST(200),PWDS(250),RN(2000)
00400		1,XWDS(250),STFF(8),NLIST(200),NX(200)
00500	C**** RN MIGHT HAVE TO BE 4000 ******
00600		EQUIVALENCE (XN,NX)
00700	
00800		JT=0
00900		JR=0
01000	72	TYPE 71
01100		ACCEPT 2,N
01200		IF(N.EQ.' ')N='PARTS'
01300		IF(N.NE.'HELP')GO TO 73
01400		TYPE 14
01500		GO TO 72
01600	73	IF(N.NE.'PARTS')GO TO 211
01700	71	FORMAT(' TYPE "MTA", "PARTS", "PACK" OR "UNPACK"  ',$)
01800		REWIND 1
01900	14	FORMAT(' FOR "READ WHICH STAFF#?"  GIVE N1, N2, N3'/'
02000		1 N2=TRANSP. STEPS,  N3=1=WILL BE SAME FOR ALL FILES'/)
02100		TYPE 1
02200		ACCEPT 2,NAME
02300		IF(LOOKD(NAME).GE.0)GO TO 13
02400		TYPE 88
02500		ACCEPT 2,L
02600		IF(L.EQ.'N')GO TO 14
02700	88	FORMAT(' WRITE OVER FILE????  '$)
02800	13	CALL OFILE(1,NAME)
02900		XWDS(1)=1
03000		RM=0
03100		L=1
03200		LX=1
03300		LP=1
03400		TYPE 44
03500		ACCEPT 5,RS
03600	10	IF(JT.EQ.0)GO TO 83
03700		NAME=NAME+2
03800		GO TO 84
03900	86	FORMAT(1XA5)
04000	83	TYPE 3
04100		ACCEPT 2,NAME,JT
04200	C  TYPE ANY NUMBER AFTER NAME AND IT WILL GO TO NEXT LETTER IN ALPH.
04300	84	LK=LP
04400		IF(LOOKD(NAME).GE.0)GO TO 20
04500	C  FOUND NO MORE TO READ
04600		TYPE 86,NAME
04700		JZ=0
04800		IF(RM.NE.0)GO TO 77
04900		TYPE 4
05000		ACCEPT 5,SN,TR,RM
05100		IF(SN.GE.99)GO TO 20
05200		GO TO 77
05300	C TYPE 2ND NUM FOR TRANSPOSE, 3RD NUM FOR ALWAYS SAME STFF.
05400	8	DO 6 K=1,ITEM
05500		J=PWDS(K)
05600		IF(RN(J+1).NE.4)GO TO 80
05700		IF(RN(J).NE.2)GO TO 80
05800	C  FOUND A BAR LINE
05900		RN(J+4)=1
06000		R=RN(J+2)
06100		DO 82 KA=K+1,ITEM
06200		KB=PWDS(KA)
06300		IF(RN(KB+1).NE.4.OR.RN(KB).NE.2)GO TO 82
06400	C  AVOIDS DUPLICATE BARS.
06500		IF(ABS(R-RN(KB+2)).GT..5)GO TO 82
06600		RN(KB+3)=99
06700		RN(KB+1)=0
06800	82	CONTINUE
06900		GO TO 81
07000	80	IF(RN(J+3).NE.SN)GO TO 6
07100		IF(RN(J+1).NE.10)GO TO 85
07200		IF(RN(J).LT.3)GO TO 85
07300		RN(J+5)=0
07400	C  SETS VERT. POS. OF STAFF TO 0.  WHAT ABOUT P6??!
07500	85	JZ=-1
07600	81	JA=PWDS(K+1)
07700		DO 7 KA=J,JA-1
07800		XN(LK)=RN(KA)
07900	7	LK=LK+1
08000		IF(L.LT.250.AND.LK.LE.2000)GO TO 50
08100		TYPE 9
08200		GO TO 20
08300	16	FORMAT(' STAFF NOT FOUND'/)
08400	50	R=XN(LP+1)
08500		IF(TR.NE.0.AND.(R.EQ.1.OR.R.EQ.8.OR.R.EQ.9))GO TO 52
08600	51	XN(LP+3)=RS
08700		L=L+1
08800		LP=LK
08900		XWDS(L)=LP
09000	6	CONTINUE
09100		IF(JZ)GO TO 17
09200		L=JX
09300		LP=JY
09400		TYPE 16
09500		GO TO 10
09600	17	JX=L
09700		JY=LP
09800		RS=RS-1
09900		M=LX+1
10000		J=XWDS(LX)
10100		PWDS(LX)=XWDS(LX)
10200		I=LX
10250		J=1
10300	CC	RA=XN(IFIX(XWDS(I)+2))
10400	24	RA=10000.
10500	C  POSITION
10700		DO 21 K=LX,L-1
10800		R=XN(IFIX(XWDS(K)+2))
10900		IF(R.GT.RA)GO TO 21
11000		I=K
11100		RA=R
11200	21	CONTINUE
11300		IF(RA.EQ.10000)GO TO 23
11400	C  JUMP IF ALL SORTED
11500		JL=XWDS(I)
11600		LA=JL
11700		N=XN(JL)+3
11800	C  NEXT POINTER
11900		PWDS(M)=PWDS(M-1)+N
12000		M=M+1
12100		DO 22 K=J,J+N-1
12200		RN(K)=XN(JL)
12300	22	JL=JL+1
12400		XN(LA+2)=10000
12500	C  PUT IT ASIDE
12600		J=N+J
12700		GO TO 24
12800	23	LB=LX
12900	25	N=PWDS(LB)
13000		R=RN(N+1)
13100		IF(R.GT.2.OR.(R.EQ.1.AND.RN(N).LT.7))GO TO 30
13200	C  LOOK ONLY AT NOTES AND RESTS AND NON-DOUBLE STOPS
13250		S=RN(N+2)
13300		LA=LB
13400	26	LA=LA+1
13450		IF(LA.GE.L)GO TO 30
13500	C  FIND NEXT IMPORTANT ITEM
13600		NA=PWDS(LA)
13700		A=RN(NA+1)
13800		IF(A.GT.4.OR.(A.EQ.4.AND.RN(NA).NE.2))GO TO 26
13900	C  USES ONLY NOTES, RESTS, BARS, CLEFS
14000	34	RX=RN(NA+2)
14100	C  POSITION OF NEXT ITEM
14150		IF(ABS(S-RX).LT..1)GO TO 26
14200		K=9
14300		IF(R.EQ.2)K=7
14400		P=RN(N+K)*10.
14500	C  FINDS RHYTH IN P7 OR P9
14600		IF(P)P=-P
14700		S=RN(N+2)
14800		SX=S+P-RX
14900	C  SPACE DIFFERENCE
15000		DO 29 K=LB+1,L-1
15100		NZ=PWDS(K)+2
15200	29	RN(NZ)=RN(NZ)+SX
15300	30	LB=LB+1
15400		IF(LB.LT.L)GO TO 25
15500	C  GO BACK IF MORE SPACING TO DO
15600		R=200./RN(IFIX(PWDS(L-1)+2))
15700	C `SHRINK FACTOR
15800		DO 31 K=LX,L-1
15900		N=PWDS(K)+2
16000	31	RN(N)=RN(N)*R
16100		DO 32 K=IFIX(PWDS(LX)),IFIX(PWDS(L))
16200	32	XN(K)=RN(K)
16300		DO 33 K=LX,L
16400	33	XWDS(K)=pWDS(K)
16500	C  ALL DONE
16600		LX=L
16700	
16800		IF(RS.GT.-4)GO TO 10
16900	20	L=JX-1
17000		J=1
17100		WRITE(1),L,JY,
17200		1 (XWDS(K),K=1,L+1),(XN(K),K=1,JY-1),J,J,J,J,RSTFAC,STFF,J
17300	15	END FILE 1
17400		CALL EXIT
17500	1	FORMAT(' TYPE OUTPUT FILE NAME  ',$)
17600	2	FORMAT(A5,I)
17700	3	FORMAT(' TYPE FILE NAME  ',$)
17800	4	FORMAT(' READ WHICH STAFF # ?  ',$)
17900	5	FORMAT(5F)
18000	9	FORMAT(' NO ROOM FOR THIS ONE')
18100	44	FORMAT(' TYPE TOP STAFF #  ',$)
18200	
18300	C TO PACK AND UNPACK FILES FOR MSS PRINTING PROG.(FOR STORAGE ONLY)
18400	211	IF(N.EQ.'MTA')GO TO 200
18500		IF(N.EQ.'UNPAC')GO TO 311
18600		TYPE 1
18700		ACCEPT 2,ONAME
18800		REWIND 1
18900		CALL OFILE (1,ONAME)
19000	411	TYPE 511
19100	511	FORMAT(' TYPE FILE NAME OR X(=EXIT)  ',$)
19200		ACCEPT 2,NAME
19300		IF(NAME.EQ.'X'.OR.NAME.EQ.' ')GO TO 811
19400	77	REWIND 21
19500	177	CALL IFILE(21,NAME)
19600	2202	IF(N.EQ.'UNPAC')GO TO 3202
19700		READ(21),ITEM,I,
19800		1 (PWDS(K),K=1,ITEM+1),(RN(K),K=1,I-1),ISCR,(IV(K),K=1,ISCR),
19900		1 LCNT,(LIST(K),K=1,LCNT)
20000		IF(I.NE.0)GO TO 91
20100		TYPE 92
20200		CALL EXIT
20300	92	FORMAT(' **** UNPACK IT FIRST ****')
20400	91	IF(N.EQ.'PARTS')GO TO 8
20500		READ(21)RSTFAC,STFF
20600		IF(JR)GO TO 217
20700		IF(N.EQ.'UNPAC')GO TO 74
20800	
20900		WRITE (1),NAME
21000		WRITE(1),ITEM,I,
21100		1 (PWDS(K),K=1,ITEM+1),(RN(K),K=1,I-1),ISCR,(IV(K),K=1,ISCR),
21200		1 LCNT,(LIST(K),K=1,LCNT),RSTFAC,STFF,K
21300		GO TO 411
21400	911	WRITE(1),ITEM,I,
21500		1 (PWDS(K),K=1,ITEM+1),(RN(K),K=1,I-1),ISCR,(IV(K),K=1,ISCR),
21600		1 LCNT,(LIST(K),K=1,LCNT),K
21700		WRITE(1),RSTFAC,STFF,IBOT,ITOP,K
21800	C***** K IS BECAUSE OF FORTRAN WRITE BUG!!!!!!
21900	CC	IF(N.EQ.'PACK')GO TO 411
22000	811	END FILE 1
22100		IF(N.EQ.'PACK')CALL EXIT
22200		IF(JR)GO TO 216
22300		GO TO 79
22400	3202	READ(21)ITEM,I,(PWDS(K),K=1,ITEM+1),(RN(K),K=1,I-1),ISCR,
22500		1 (IV(K),K=1,ISCR),LCNT,(LIST(K),K=1,LCNT),RSTFAC,STFF
22600		GO TO 74
22700	
22800	200	TYPE 201
22900		REWIND 16
23000		ACCEPT 111,L
23100		IF(L.EQ.'W')GO TO 202
23200	1200	CALL IFILE(16,N)
23300		READ(16)NLIST
23400		IF(L.EQ.'W')GO TO 202
23500		DO 204 KX=1,200
23600		IF(NLIST(KX).EQ.' ')GO TO 205
23700		IF(MOD(KX,16).EQ.0)PAUSE
23800	204	TYPE 112,KX,NLIST(KX)
23900	205	M=1
24000		L=1
24100	209	TYPE 206
24200		ACCEPT 2,NX(M)
24300		REREAD 207,J,N
24400	CZ	IF(N.NE.0)GO TO 208
24500		IF(NX(M).EQ.' ')GO TO 210
24600		M=M+1
24700		GO TO 209
24800	210	J=1
24900	216	IF(NX(J).EQ.' ')GO TO 219
25000		DO 212 KX=L,200
25100		READ(16),NJ,ITEM,I,PWDS,RN,ISCR,IV,LCNT,LIST,
25200		1 RSTFAC,STFF,IBOT,ITOP
25300	212	IF(NJ.EQ.NX(J))GO TO 218
25400	218	NAME=NJ
25500		J=J+1
25600		L=KX+1
25700		GO TO 179
25800	220	FORMAT(' NEW TAPE OR OLD?  ',$)
25900	
26000	202	TYPE 220
26100		ACCEPT 111,LX
26200		IF(LX.EQ.'O')GO TO 1200
26300		CALL OFILE(16,N)
26400		JR=-1
26500		N=0
26600	214	N=N+1
26700		TYPE 3
26800		ACCEPT 203,NLIST(N)
26900		IF(NLIST(N).NE.' ')GO TO 214
27000	213	WRITE(16),NLIST
27100		M=1
27200	215	NAME=NLIST(M)
27300		GO TO 177
27400	217	WRITE(16),NAME,ITEM,I,PWDS,RN,ISCR,IV,LCNT,LIST,
27500		1 RSTFAC,STFF,IBOT,ITOP,K
27600		TYPE 111,K,NAME
27700		M=M+1
27800		IF(M.NE.N)GO TO 215
27900	219	REWIND 16
28000		CALL EXIT
28100	201	FORMAT(' READ OR WRITE?  ',$/)
28200	203	FORMAT(200A5)
28300	206	FORMAT(' TYPE FILE NAME OR NUMS.  ',$)
28400	112	FORMAT(I4,2XA5)
28500	207	FORMAT(2I)
28600	311	TYPE 511
28700		ACCEPT 2,NAME
28800		IF(NAME.EQ.'X'.OR.NAME.EQ.' ')CALL EXIT
28900		CALL IFILE(21,NAME)
29000	79	READ (21,END=75),NAME
29100		GO TO 2202
29200	74	K=' '
29300		TYPE 111,K,NAME
29400		TYPE 76
29500		ACCEPT 2,K
29600		IF(K.EQ.'PASS'.OR.K.EQ.'P')GO TO 79
29700		IF(K.EQ.'X')CALL EXIT
29800		IF(K.NE.' ')NAME=K
29900	179	CALL OFILE(1,NAME)
30000		GO TO 911
30100	75	CALL EXIT
30200	76	FORMAT(' TYPE <CR>, <PASS> OR NEW NAME.  X=EXIT  ',$)
30300	111	FORMAT(A1,A5)
30400	
30500	52	A=XN(LP+4)
30600		XN(LP+4)=A+TR
30700	C TRANSPOSES ONLY BY STAFF STEPS FOR NOW
30800		X=XN(LP+5)
30900		IF(XN(LP+1).EQ.1)GO TO 11
31000		XN(LP+5)=X+TR
31100		GO TO 51
31200	11	IF(TR.EQ.4.AND.AMOD(A,7.0).EQ.0)GO TO 101
31300		IF(AMOD(TR-1.0,7.0).NE.0)GO TO 51
31400	C  NEXT IS FOR Bb TRANSP.
31500		B=AMOD(A+7.0,7.0)
31600		IF(B.NE.0.AND.B.NE.3)GO TO 51
31700	C  FINDS ORIG. E OR B
31800	101	M=AMOD(X,10.0)
31900	C  FINDS ACCID.
32000		X=X-M
32100	C  STEM DIR. AND DECI.
32200		B=3.
32300	C CHANGES FLAT TO NATURAL SIGN.
32400		IF(M.EQ.0.OR.M.EQ.3)B=2
32500	C  NO PROVISION YET FOR ## OR bb
32600		XN(LP+5)=X+B
32700		GO TO 51
32800		END